home *** CD-ROM | disk | FTP | other *** search
/ ETO Development Tools 4 / ETO Development Tools 4.iso / Tools - Objects / MacApp / MacApp 3.0a2 / Libraries / UPascalTool.inc1.p < prev    next >
Encoding:
Text File  |  1991-05-01  |  8.8 KB  |  386 lines  |  [TEXT/MPS ]
  1. {[a-,body+,h-,o=100,r+,rec+,t=4,u+,#+,j=20/57/1$,n-]}
  2.  
  3. USES UList, UAssociation, UFailure, TextEdit, OSUtils, UMacAppUniversal, Editions, UMacAppUtilities, UPatch,
  4.      Events, CursorCtl, Signal, PasLibIntf, IntEnv, ErrMgr, Packages, Script, Resources, Fonts;
  5.  
  6. {--------------------------------------------------------------------------------------------------}
  7.  
  8. {$S TInit}
  9.  
  10. PROCEDURE InitUPascalTool;
  11.  
  12.     BEGIN
  13.     gPascalTool := NIL;
  14.     { Do Tool related initialization }
  15.     InitGraf(@thePort);
  16.     SetFScaleDisable(true);                             { per chapter in MPW guide on tools }
  17.  
  18.     InitCursorCtl(NIL);
  19.     RotateCursor(0);
  20.  
  21.     InitErrMgr('', '', false);
  22.  
  23.     gProgName := ArgV^[0]^;
  24.  
  25. {$IFC qDebug}                                            { Enable pre and postcondition testing }
  26.     gPreCondition := TRUE;
  27.     gPostCondition := TRUE;
  28. {$ENDC}
  29.  
  30.     { -1 = $FFFFFFFF, the largest 32 bit address.  Our routine StripLong uses a pre-stripped
  31.     address gStrippedAddress to avoid the yucky MPW glue.
  32.     (NOTE: need gStrippedAddress in DefineConfiguration.) }
  33.     gStrippedAddress := StripAddress(Ptr( - 1));
  34.  
  35.     { Find out just what kind of environment we're dealing with here }
  36.     DefineConfiguration(gConfiguration);
  37.  
  38.     { Init the stuff that MATextBox uses }
  39.     gMATextBoxTE := NIL;
  40.     gTEDefaultWordBreak := NIL;
  41.  
  42. { Init all the primary colors }
  43.     SetRGBColor(gRGBBlack, 0, 0, 0);
  44.     SetRGBColor(gRGBWhite, $FFFF, $FFFF, $FFFF);
  45.     SetRGBColor(gRGBRed, $FFFF, 0, 0);
  46.     SetRGBColor(gRGBGreen, 0, $FFFF, 0);
  47.     SetRGBColor(gRGBBlue, 0, 0, $FFFF);
  48.  
  49. { setup the zeroed points and rects }
  50.     SetPt(gZeroPt, 0, 0);
  51.     SetRect(gZeroRect, 0, 0, 0, 0);
  52.  
  53. {$IFC qDebug OR qInspector}
  54.     gFieldToStrRtn := @StdFieldToString;
  55.     gFieldToCountRtn := @StdFieldToCount;
  56. {$EndC}
  57.  
  58.     gBoolString[TRUE] := 'TRUE';
  59.     gBoolString[FALSE] := 'FALSE';
  60.     gDeadStripSuppression := FALSE;
  61.     { The refnum where the application's resources should be found }
  62.     gApplicationRefNum := CurResFile;
  63.  
  64. {$IFC qDebug}
  65.     gExperimenting := FALSE;
  66.     gDebugPrinting := FALSE;
  67.     gReportMenuChoices := FALSE;
  68.     gIntenseDebugging := FALSE;
  69.     gReportEvt := FALSE;
  70. {$ENDC}
  71.  
  72.     gToolBoxInitialized := TRUE;
  73.  
  74.     { Do Object related initialization }
  75.     InitUObject;
  76.  
  77.     END;
  78.  
  79. {--------------------------------------------------------------------------------------------------}
  80. {$S TRes}
  81.  
  82. PROCEDURE Intr;
  83.  
  84.     BEGIN
  85.     gPascalTool.fInterrupted := true;                     {we test this switch periodically}
  86.     END;
  87.  
  88. {--------------------------------------------------------------------------------------------------}
  89. {$S TRes}
  90.  
  91. PROCEDURE TPascalTool.Stop(msg: Str255);
  92.  
  93.     BEGIN
  94.     IF Length(msg) > 0 THEN
  95.         BEGIN
  96.         PLFlush(Output);
  97.         WriteLn(Diagnostic);
  98.         WriteLn(Diagnostic, msg);
  99.         END;
  100.  
  101.     IF fInterrupted THEN
  102.         IEexit( - 9);
  103.  { don't worry about closing the files we opened.  The Shell
  104.   will do so if appropriate.}
  105.     IEexit(Ord(fRetCode));                                {exit, returning the appropriate status
  106.                                                          code}
  107.     END;
  108.  
  109. {--------------------------------------------------------------------------------------------------}
  110. {$S TInit}
  111.  
  112. PROCEDURE TPascalTool.SyntaxError(suffix: Str255);
  113.  
  114.     VAR
  115.         aStr:                Str255;
  116.  
  117.     BEGIN
  118.     aStr := fProgName;
  119.     PLFlush(Output);
  120.     WriteLn(Diagnostic, kErrorMarker, 'Bad Parameter: ', suffix);
  121.     WriteLn(Diagnostic, kErrorMarker, aStr, '<invalid option>');
  122.     Stop('');
  123.     END;
  124.  
  125. {--------------------------------------------------------------------------------------------------}
  126. {$S TInit}
  127.  
  128. PROCEDURE TPascalTool.DoShowUsage;
  129.  
  130.     VAR
  131.         aStr:                Str255;
  132.  
  133.     BEGIN
  134.     aStr := fProgName;
  135.     WriteLn(Diagnostic, '# Usage: ', aStr, ' [-p]');
  136.     END;
  137.  
  138. {--------------------------------------------------------------------------------------------------}
  139. {$S TInit}
  140.  
  141. FUNCTION TPascalTool.GetNextArg: Str255;
  142.  
  143.     BEGIN
  144.     fArgVIndex := fArgVIndex + 1;
  145.     IF fArgVIndex > ArgC THEN
  146.         Stop('Not enough arguments');
  147.     GetNextArg := ArgV^[fArgVIndex]^;
  148.     END;
  149.  
  150. {--------------------------------------------------------------------------------------------------}
  151. {$S TInit}
  152.  
  153. PROCEDURE TPascalTool.InstallKeyWords;
  154.  
  155.     BEGIN
  156.     InstallKeyWord('P', kwP);
  157.     InstallKeyWord('NoP', kwNoP);
  158.     InstallKeyWord('T', kwT);
  159.     InstallKeyWord('NoT', kwNoT);
  160.     InstallKeyWord('Help', kwHelp);
  161.     END;
  162.  
  163. {--------------------------------------------------------------------------------------------------}
  164. {$S TInit}
  165.  
  166. PROCEDURE TPascalTool.InstallKeyWord(keyword: Str255;
  167.                                   kw: Integer);
  168.  
  169.     VAR
  170.         value:                Str255;
  171.  
  172.     BEGIN
  173.     UprStr255(keyword);
  174.     value[0] := chr(2);
  175.     value[1] := chr(BSR(Band(kw, $FF00), 8));
  176.     value[2] := chr(Band(kw, $00FF));
  177.     fKeyWordList.InsertEntry(keyword, value);
  178.     END;
  179.  
  180. {--------------------------------------------------------------------------------------------------}
  181. {$S TInit}
  182.  
  183. FUNCTION TPascalTool.LookupKeyword(keyword: Str255;
  184.                                 VAR kw: Integer): BOOLEAN;
  185.  
  186.     VAR
  187.         value:                Str255;
  188.  
  189.     BEGIN
  190.     UprStr255(keyword);
  191.     IF fKeyWordList.ValueAt(keyword, value) THEN
  192.         BEGIN
  193.         LookupKeyword := true;
  194.         kw := BOR(BSL(ord4(value[1]), 8), Ord(value[2]));
  195.         END
  196.     ELSE
  197.         LookupKeyword := false;
  198.     END;
  199.  
  200. {--------------------------------------------------------------------------------------------------}
  201. {$S TInit}
  202.  
  203. PROCEDURE TPascalTool.ProcessArg(arg: Str255);
  204.  
  205.     VAR
  206.         akw:                Integer;
  207.  
  208.     BEGIN
  209.     IF arg[1] <> '-' THEN
  210.         DoProcessFileArg(arg)
  211.     ELSE
  212.         BEGIN
  213.         IF LookupKeyword(copy(arg, 2, Length(arg) - 1), akw) THEN
  214.             DoProcessOptionArg(akw)
  215.         ELSE
  216.             SyntaxError(Concat(ArgV^[fArgVIndex]^, ' <invalid option>'));
  217.         END;
  218.     END;
  219.  
  220. {--------------------------------------------------------------------------------------------------}
  221. {$S TInit}
  222.  
  223. PROCEDURE TPascalTool.DoProcessFileArg(arg: Str255);
  224.  
  225.     BEGIN
  226.     SyntaxError(Concat(ArgV^[fArgVIndex]^, ' <invalid option>'));
  227.     END;
  228.  
  229. {--------------------------------------------------------------------------------------------------}
  230. {$S TInit}
  231.  
  232. PROCEDURE TPascalTool.DoProcessOptionArg(kw: Integer);
  233.  
  234.     BEGIN
  235.     CASE kw OF
  236.         kwP:
  237.             fProgress := true;
  238.         kwNoP:
  239.             fProgress := false;
  240.         kwT:
  241.             fTime := true;
  242.         kwNoT:
  243.             fTime := false;
  244.         kwHelp:
  245.             BEGIN
  246.             DoShowUsage;
  247.             fRetCode := RC_Normal;
  248.             Stop('');
  249.             END;
  250.         OTHERWISE
  251.             SyntaxError(Concat(ArgV^[fArgVIndex]^, ' <invalid option>'));
  252.     END;
  253.     END;
  254.  
  255. {--------------------------------------------------------------------------------------------------}
  256. {$S TInit}
  257.  
  258. PROCEDURE TPascalTool.DoStartProgress;
  259.  
  260.     VAR
  261.         aStr:                Str255;
  262.  
  263.     BEGIN
  264.     aStr := fProgName;
  265.     WriteLn(Diagnostic);
  266.     WriteLn(Diagnostic, aStr, '  (Ver ', Version, ') ');
  267.     WriteLn(Diagnostic);
  268.     WriteLn(Diagnostic);
  269.     END;
  270.  
  271. {--------------------------------------------------------------------------------------------------}
  272. {$S TInit}
  273. PROCEDURE TPascalTool.Initialize; OVERRIDE;
  274. BEGIN
  275.     INHERITED Initialize;
  276.     fArgVIndex := 0;
  277.     fCursorCount := 0;            { prepare to spin that cursor}
  278.     fInterrupted := FALSE;        { becomes TRUE when interrupted}
  279.     fKeyWordList := NIL;        { keywords to this command }
  280.     fProgName := '';             { Program's file name}
  281.     fProgress := FALSE;
  282.     fRetCode := RC_Normal;
  283.     fStartDateTime := 0;        { Date/Time at start of tool }
  284.     fStartTicks := 0;            { tickcount at start of tool }
  285.     fTime := FALSE;
  286. END;
  287.  
  288. {--------------------------------------------------------------------------------------------------}
  289. {$S TInit}
  290.  
  291. PROCEDURE TPascalTool.IPascalTool;
  292.  
  293.     VAR
  294.         holdIndex:            Integer;
  295.         prevSig:            SignalHandler;
  296.         arg:                Str255;
  297.         theDateTime:        Longint;
  298.         anAssociation:        TAssociation;
  299.  
  300.     BEGIN
  301.     IObject;
  302.     gPascalTool := SELF;
  303.     fStartTicks := TickCount;
  304.     GetDateTime(theDateTime);
  305.     fStartDateTime := theDateTime;
  306.  
  307.     SpinCursor(1);
  308.     prevSig := IEsignal(SIGINT, @Intr);
  309.  
  310.     fProgName := ArgV^[0]^;
  311.     gProgName := fProgName;
  312.     fRetCode := RC_ParmErrs;
  313.  
  314.     IF fInterrupted THEN
  315.         Stop('');
  316.  
  317.     New(anAssociation);
  318.     anAssociation.IAssociation;
  319.     fKeyWordList := anAssociation;
  320.  
  321.     InstallKeyWords;
  322.     END;
  323.  
  324. {--------------------------------------------------------------------------------------------------}
  325. {$S TRes}
  326.  
  327. PROCEDURE TPascalTool.Run;
  328.  
  329.     VAR
  330.         fi:                 FailInfo;
  331.  
  332.     LABEL 1000;
  333.  
  334.     PROCEDURE HdlFailure(error: Integer;
  335.                          message: Longint);
  336.  
  337.         VAR
  338.             theErr:             OSErr;
  339.             theText:            Str255;
  340.  
  341.         BEGIN
  342.         theErr := error;
  343.         IF theErr <> noErr THEN
  344.             BEGIN
  345.             GetSysErrText(theErr, @theText);
  346.             WriteLn(Diagnostic, kErrorMarker, gProgName, ': ', theText);
  347.             fRetCode := RC_Abort;
  348.             END;
  349.         GOTO 1000;
  350.         END;
  351.  
  352.     BEGIN
  353.     CatchFailures(fi, HdlFailure);
  354.     fArgVIndex := 1;
  355.     WHILE fArgVIndex < ArgC DO                            {ArgC is the number of args plus one}
  356.         BEGIN
  357.         fCursorCount := fCursorCount + 1;
  358.         RotateCursor(fCursorCount);
  359.         ProcessArg(ArgV^[fArgVIndex]^);
  360.         fArgVIndex := fArgVIndex + 1;
  361.         END;
  362.     UnloadSeg(@InitUPascalTool);
  363.     fRetCode := RC_Normal;
  364.  
  365.     IF fProgress THEN
  366.         DoStartProgress;
  367.     DoToolAction;
  368.     IF fTime THEN
  369.         WriteLn(Diagnostic, 'Elapsed time: ', (TickCount - fStartTicks) / 60: 1: 2, ' seconds');
  370.     Success(fi);
  371. 1000:
  372.     IEexit(Ord(fRetCode));
  373.     END;
  374. {--------------------------------------------------------------------------------------------------}
  375. {$S TRes}
  376.  
  377. PROCEDURE TPascalTool.DoToolAction;
  378.  
  379.     VAR
  380.         aStr:                Str255;
  381.  
  382.     BEGIN
  383.     aStr := fProgName;
  384.     WriteLn(Diagnostic, kErrorMarker, aStr, ': Forgot to override the default tool action');
  385.     END;
  386.